home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1996 #14 / Monster Media No. 14 (April 1996) (Monster Media, Inc.).ISO / prog_bas / oledsrvr.zip / OLESRV3.BAS < prev    next >
BASIC Source File  |  1996-01-03  |  1KB  |  81 lines
  1. Attribute VB_Name = "Module1"
  2. Option Explicit
  3.  
  4. Private mdb As Database
  5. Public InstanceCount As Integer
  6.  
  7. Public gcolQueue As New Collection
  8.  
  9.  
  10. '----- Compiler constant #testing is set to 0 or -1 in
  11. '      Tools/Options/Advanced.
  12.  
  13. '      OPTIONAL: INSERT YOUR PATH HERE.
  14. '       If dbpath = "" then app.path will be used.
  15. #If Testing Then
  16.   'Const dbpath = "c:\vb4source\oleserver_test3"
  17.   Const dbpath = ""
  18. #Else
  19.   Const dbpath = ""
  20. #End If
  21.  
  22.  
  23.  
  24.  
  25.  
  26. Sub Main()
  27.  
  28. If App.StartMode = vbSModeStandalone Then
  29.   MsgBox "this program only available as an OLE server"
  30.   End
  31. End If
  32.  
  33. End Sub
  34.  
  35.  
  36.  
  37.  
  38.  
  39.  
  40. Sub DBOpen()
  41. If mdb Is Nothing Then
  42.   If dbpath = "" Then
  43.     Set mdb = OpenDatabase(App.Path & "\server2.mdb")
  44.   Else
  45.     Set mdb = OpenDatabase(dbpath & "\server2.mdb")
  46.   End If
  47. End If
  48.  
  49. End Sub
  50.  
  51.  
  52. Sub DBClose()
  53. If Not mdb Is Nothing Then
  54.   mdb.Close
  55.   Set mdb = Nothing
  56. End If
  57. End Sub
  58.  
  59.  
  60. Function NxtItm() As Long
  61.   Dim lngItm As Long
  62.   Dim ss As Recordset
  63.   
  64.   Set ss = mdb.OpenRecordset("select NextItem from NextItem", dbOpenDynaset)
  65.   If ss.BOF Then
  66.     lngItm = 1
  67.     ss.AddNew
  68.   Else
  69.     lngItm = ss!NextItem
  70.     ss.Edit
  71.   End If
  72.   
  73.   ss!NextItem = lngItm + 1
  74.   ss.Update
  75.   ss.Close
  76.   Set ss = Nothing
  77.   NxtItm = lngItm
  78. End Function
  79.  
  80.  
  81.